home *** CD-ROM | disk | FTP | other *** search
/ Mac Mania 2 / MacMania 2.toast / Demo's / Tools&Utilities / Programming / HELP language 1.4 / Help Files / Compilation / Machine < prev    next >
Encoding:
Text File  |  1991-04-26  |  3.3 KB  |  123 lines  |  [TEXT/Help]
  1. ;••• GENERATION DE CODE - Machine •••
  2.  
  3. (define (registre? r)(memq? r '(sp lp r0 r1 r2 a0 a1 d0 d1)))
  4.  
  5. (define (nec-mode-s m)
  6.    (cond (atom? m) (cond (eq? m 'r2) (list 'R2 'ce) (list m))
  7.          (null? (-1 m)) m
  8.          (eq? (0 m) '-) (list (1 m))
  9.          (eq? (0 m) '#) ()
  10.          (eq? (1 m) '+) (list (0 m))
  11.          (data? m)  ()
  12.          (number? (0 m)) (cond (eq? (1 m) 'PC) ()
  13.                                (list (1 m)))))
  14.  
  15. (define (nec-mode-d m)
  16.    (cond (atom? m) ()
  17.          (data? m)  ()
  18.          (null? (-1 m)) m
  19.          (eq? (0 m) '-) (list (1 m))
  20.          (eq? (1 m) '+) (list (0 m))
  21.          (number? (0 m)) (cond (eq? (1 m) 'PC) () (list (1 m)))))
  22.          
  23. (define (mod-mode-d m)
  24.    (cond (not m) ()
  25.          (atom? m) (list m)
  26.          (data? m)  ()
  27.          (null? (-1 m)) (list 'm)
  28.          (eq? (0 m) '-) (cond (neq? (1 m) 'SP) (list 'm) ())
  29.          (eq? (1 m) '+) (cond (neq? (0 m) 'LP) (list 'm) ())
  30.          (number? (0 m)) (list 'm)))
  31.          
  32. ;un RTS necessite R0 (retour de valeur)
  33.  
  34. (define (synt-rts )
  35.     (mpthunk '((rts))
  36.               (minfo '(r0) '() ())))
  37.  
  38. (define (synt-call t)
  39.    (mpthunk `((jsr (,(source t) A5)))
  40.               (minfo (union-set '() (nec t)) (mod t) (str t))))
  41.  
  42. (define (synt-callo t)
  43.    (mpthunk `((jmp (,(source t) A5)))
  44.              (minfo (union-set '(r0) (nec t)) (mod t) (str t))))
  45.  
  46. (define (synt-jsr m)
  47.   (mpthunk `((jsr ,m))
  48.            (minfo (nec-mode-s m)
  49.                   '(r0 r1 r2 a0 a1 d0 d1) ())))
  50.  
  51. (define (synt-jmp m)
  52.     (mpthunk `((jmp ,m))
  53.            (minfo (nec-mode-s m)
  54.                   '(r0 r1 r2 a0 a1 d0 d1) ())))
  55.  
  56. (define (synt-beq l)
  57.    (mpthunk `((beq ,(-1 l) ,(where l)))
  58.              (minfo () () ())))
  59.  
  60. (define (synt-bpl l)
  61.   (mpthunk `((bpl ,(-1 l) ,(where l)))
  62.             (minfo () () ())))
  63.  
  64. (define (synt-bra l)
  65.    (mpthunk `((bra ,(-1 l) ,(where l)))
  66.              (minfo  () () ())))
  67.  
  68. (define (synt-label l)
  69.   (mpthunk `((label ,(-1 l) ,(where l)))
  70.             (minfo ()()())))
  71.  
  72. (define (synt-cmp s m1 m2)
  73.   (mpthunk `((cmp ,s ,m1 ,m2))
  74.             (minfo (append (nec-mode-s m1)
  75.                            (nec-mode-d m2))
  76.                    ()())))
  77.  
  78. (define (synt-btst n m)
  79.   (mpthunk `((btst (# ,n) ,m))
  80.             (minfo (nec-mode-s m)()())))
  81.  
  82. (define (synt-bset n m)
  83.   (mpthunk `((bset (# ,n) ,m))
  84.             (minfo (nec-mode-d m)
  85.                    (mod-mode-d m)())))
  86.  
  87. (define (synt-bclr n m)
  88.   (mpthunk `((bclr (# ,n) ,m))
  89.             (minfo (nec-mode-d m)
  90.                    (mod-mode-d m)())))
  91.  
  92. (define (synt-or s m1 m2)
  93.   (mpthunk `((or ,s ,m1 ,m2))
  94.             (minfo (append (nec-mode-s m1)
  95.                            (nec-mode-d m2))
  96.                    (mod-mode-d m2)())))
  97.  
  98. (define (synt-sub s m1 m2)
  99.   (mpthunk `((sub ,s ,m1 ,m2))
  100.             (minfo (append (nec-mode-s m1)
  101.                            (nec-mode-d m2))
  102.                    (mod-mode-d m2)())))
  103.  
  104. (define (synt-tst s m)
  105.   (mpthunk `((tst ,s ,m))
  106.             (minfo (nec-mode-s m)
  107.                    ()())))
  108.  
  109. (define (synt-lea m1 m2)
  110.   (mpthunk `((lea ,m1 ,m2))
  111.             (minfo (nec-mode-s m1)
  112.                    (nec-mode-d m2)())))
  113.  
  114. (define (synt-move s m1 m2)
  115.          (cond (and (<>? m1 m2)
  116.                   (neq? m2 ƒ))
  117.              (mpthunk `((move ,s ,m1 ,m2))
  118.                        (minfo (union-set  (nec-mode-s m1)
  119.                                                      (nec-mode-d m2))
  120.                               (mod-mode-d m2)()))
  121.              (empty-pthunk)))
  122.  
  123.